home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / clickb1r / printmai.bas < prev    next >
BASIC Source File  |  1999-07-21  |  15KB  |  334 lines
  1. Attribute VB_Name = "Module1"
  2.     Dim strdata As String           'variable for included/excluded words
  3.     Dim base64 As String
  4.     Dim counter As Integer          'counts through included/excluded words
  5.     Dim filenam As String           'filename of file to extract
  6.     Dim firstline As String         'each line of .eml file
  7.     Dim appath As String            'application & .eml file path
  8.  
  9.  Private Function Base64Decode(Basein As String) As String
  10.  
  11.     Dim counter As Integer
  12.     Dim Temp As String
  13.     'For the dec. Tab
  14.     Dim DecodeTable As Variant
  15.     Dim Out(2) As Byte
  16.     Dim inp(3) As Byte
  17.     
  18.     'DecodeTable holds the decode tab
  19.     DecodeTable = Array("255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "62", "255", "255", "255", "63", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "255", "255", "255", "64", "255", "255", "255", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", _
  20.     "18", "19", "20", "21", "22", "23", "24", "25", "255", "255", "255", "255", "255", "255", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255" _
  21.     , "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255")
  22.     'Reads 4 Bytes in and decrypt them
  23.  
  24.     For counter = 1 To Len(Basein) Step 4
  25.         '4 Bytes in -> 3 Bytes out
  26.         inp(0) = DecodeTable(Asc(Mid$(Basein, counter, 1)))
  27.         inp(1) = DecodeTable(Asc(Mid$(Basein, counter + 1, 1)))
  28.         inp(2) = DecodeTable(Asc(Mid$(Basein, counter + 2, 1)))
  29.         inp(3) = DecodeTable(Asc(Mid$(Basein, counter + 3, 1)))
  30.         Out(0) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  31.         Out(1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
  32.         Out(2) = ((inp(2) And &H3) * 64) Or inp(3)
  33.         '* look for "=" symbols
  34.  
  35.         If inp(2) = 64 Then
  36.             'If there are 2 characters left -> 1 binary out
  37.             Out(0) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  38.             Temp = Temp & Chr(Out(0) And &HFF)
  39.         ElseIf inp(3) = 64 Then
  40.             'If there are 3 characters left -> 2 binaries out
  41.             Out(0) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  42.             Out(1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
  43.             Temp = Temp & Chr(Out(0) And &HFF) & Chr(Out(1) And &HFF)
  44.         Else 'Return three Bytes
  45.             Temp = Temp & Chr(Out(0) And &HFF) & Chr(Out(1) And &HFF) & Chr(Out(2) And &HFF)
  46.         End If
  47.  
  48.     Next
  49.  
  50.     Base64Decode = Temp
  51.     
  52. End Function
  53.  
  54.  
  55. Private Sub decode()
  56.  
  57.     'filenam = Mid(firstline, 8, Len(firstline) - 8)     'get filename of file to extract
  58.     'Line Input #2, firstline
  59.     
  60.     If filenam = "" Then
  61.         decodeimbed64
  62.     ElseIf base64 = "base64" Then
  63.         decode64
  64.     ElseIf Right(filenam, 4) = ".rtf" Then
  65.         decodeRTF
  66.     ElseIf Right(filenam, 4) = ".txt" Then
  67.         decodeTXT
  68.     Else
  69.         Print #1,
  70.         Print #1, Chr(9) + "file: " + filenam + " NOT extracted"
  71.         Do While Not EOF(2)
  72.         Line Input #2, firstline
  73.             Do Until strdata = "EndofData"      'repeat until all invalid words checked
  74.                 getbadwords                                 ' get next invalid word
  75.                 If InStr(firstline, strdata) Then Exit Do       'if line includes invalid word then exit loop
  76.             Loop                        ' round again for next invalid word
  77.             If strdata <> "EndofData" Then Exit Do
  78.         Loop
  79.         strdata = "NextPart"
  80.         Exit Sub
  81.     End If
  82.     
  83.     Close #3
  84.     Print #1,
  85.     Print #1, Chr(9) + "file: " + filenam + " extracted"
  86.     strdata = "NextPart"
  87.     filenam = ""
  88.     base64 = ""
  89.     
  90. End Sub
  91.     
  92. Private Sub decode64()
  93.     
  94.     Dim bin64 As String
  95.     
  96.     Open appath + "\" + filenam For Output As #3    'open file to extract to
  97.     
  98.     While Trim(firstline) <> ""             'get rid of blank lines
  99.         Line Input #2, firstline
  100.     Wend
  101.     
  102.     While InStr(firstline, "NextPart") = Not True       'till end of data
  103.         Line Input #2, firstline
  104.         If (Len(firstline) Mod 4) = 0 Then     'line must be a multiple of 4
  105.             bin64 = Base64Decode(firstline)    'call decoder
  106.             Print #3, bin64;                'print decoded data to file
  107.         Else
  108.             Exit Sub
  109.         End If
  110.     Wend
  111.     
  112. End Sub
  113.  
  114. Private Sub decodeimbed64()
  115.     
  116.     Dim bin64 As String
  117.     
  118.     While Trim(firstline) <> ""             'get rid of blank lines
  119.         Line Input #2, firstline
  120.     Wend
  121.     
  122.     While InStr(firstline, "NextPart") = Not True       'till end of data
  123.         Line Input #2, firstline
  124.         If (Len(firstline) Mod 4) = 0 Then     'line must be a multiple of 4
  125.             bin64 = Base64Decode(firstline)    'call decoder
  126.             Print #1, bin64;                'print decoded data to file
  127.         Else
  128.             Exit Sub
  129.         End If
  130.     Wend
  131.     
  132. End Sub
  133.  
  134. Private Sub decodeRTF()
  135.  
  136.     Open appath + "\" + filenam For Output As #3    'open file to extract to
  137.     
  138.     While Trim(firstline) <> ""             'get rid of blank lines
  139.         Line Input #2, firstline
  140.     Wend
  141.     
  142.     While InStr(firstline, "NextPart") = Not True       'till end of data
  143.         Line Input #2, firstline
  144.         If Right(firstline, 1) = "=" Then
  145.             Print #3, Left(firstline, Len(firstline) - 1);
  146.         ElseIf Len(firstline) < 3 Then
  147.             Print #3, firstline
  148.         ElseIf Len(firstline) > 2 And Mid(firstline, Len(firstline) - 2, 1) = "=" Then
  149.             Print #3, Left(firstline, Len(firstline) - 3);
  150.         ElseIf InStr(firstline, "NextPart") = Not True Then
  151.             Print #3, firstline
  152.         End If
  153.     Wend
  154.     
  155. End Sub
  156.  
  157. Private Sub decodeTXT()
  158.  
  159.     Open appath + "\" + filenam For Output As #3    'open file to extract to
  160.     
  161.     While Trim(firstline) <> ""             'get rid of blank lines
  162.         Line Input #2, firstline
  163.     Wend
  164.     
  165.     While InStr(firstline, "NextPart") = Not True       'till end of data
  166.         Line Input #2, firstline
  167.         If InStr(firstline, "NextPart") = Not True Then
  168.             If Right(firstline, 1) = "=" Then
  169.                 Print #3, Left(firstline, Len(firstline) - 1)
  170.             Else
  171.                 Print #3, firstline
  172.             End If
  173.         End If
  174.     Wend
  175.     
  176. End Sub
  177.  Private Sub Main()
  178.  
  179.     Dim nextfile As String      'filename of .eml file
  180.     Dim lastline As String      'checks multiple blank lines
  181.     Dim filenum As Integer      'counts messages
  182.     
  183.     appath = App.Path           'sets path
  184.     nextfile = Dir(appath + "\*.eml")       'gets first .eml filename
  185.     strdata = ""                            'initialises variable
  186.     
  187.     'HEADER SECTION
  188.     
  189.     If nextfile <> "" Then
  190.         Open appath + "\EHCNet3.tmp" For Output As #1    'if .eml file present open text file for writing
  191.         Open appath + "\EHCNet3.txt" For Output As #4    'if .eml file present open index file for writing
  192.         form1.Visible = True
  193.         form1.Refresh
  194.     End If
  195.     
  196.     Print #1,
  197.     Prin